home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / CUA_SAMP.ZIP / CALC.PRG < prev    next >
Text File  |  1994-10-12  |  11KB  |  339 lines
  1.  
  2. *.............................................................................
  3. *
  4. *   Program Name: CALC.PRG            Copyright: Borland International
  5. *   Date Created: 12/12/93             Language: dBASE 5.0
  6. *   Time Created: 15:02:45               Author: Borland dBASE R&D
  7. *   /brief/library.src
  8. *.............................................................................
  9.  
  10. #include "TECLASD.HDB"
  11.  
  12. #define kBell  CHR(7)
  13. #define kPoint SET("POINT")
  14.  
  15. #define ALLTRIM(kStr)  LTRIM(RTRIM(kStr))
  16.  
  17. *.........................................................
  18. * Procedure Name:   Calc
  19. * Parameters:       None
  20. * Ext Memvars:      None
  21. * Description:      Main procedure for calculator program
  22. *.........................................................
  23. PROCEDURE Calc
  24.     PRIVATE lVoid
  25.  
  26.     SET TALK OFF
  27.  
  28.     IF TYPE( "_CmdWindow.dbCalc.Top" ) # "N"
  29.         DO DefCalc
  30.     ENDIF
  31.  
  32.     lVoid = _CmdWindow.dbCalc.bequal.SetFocus()
  33.     lVoid = _CmdWindow.dbCalc.Open()
  34.  
  35. RETURN
  36.  
  37.  
  38. *...............................................
  39. * Procedure Name:   DefCalc
  40. * Parameters:       None
  41. * Ext Memvars:      None
  42. * Description:      Defines the calculator form
  43. *...............................................
  44. PROCEDURE DefCalc
  45.  
  46.     #include "DBCALC.DFM"
  47.  
  48.     dbCalc.bDec.Text = "~" + SET("POINT") + "~"
  49.  
  50.     _CmdWindow.dbCalc = m->dbCalc
  51.  
  52. RETURN
  53.  
  54.  
  55. *.............................................
  56. * Procedure Name:   BuMinus
  57. * Parameters:       None
  58. * Ext Memvars:      _CmdWindow.dbCalc.e.Text
  59. * Description:      processes "+/-" key
  60. *.............................................
  61. PROCEDURE BuMinus
  62.     PRIVATE cStr, nVal
  63.  
  64.     cStr = ""
  65.     nVal = 0.0
  66.  
  67.     cStr = CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text))
  68.     nVal = VAL(m->cStr)
  69.     nVal = m->nVal * (-1)
  70.     cStr = MakeNum(m->nVal)
  71.  
  72.     _CmdWindow.dbCalc.e.Text = m->cStr
  73.  
  74. RETURN
  75.  
  76.  
  77. *.......................................................
  78. * Procedure Name:   BClear
  79. * Parameters:       None
  80. * Ext Memvars:      _CmdWindow.dbCalc
  81. * Description:      Clears the values in the calculator
  82. *.......................................................
  83. PROCEDURE BClear
  84.     PRIVATE lVoid
  85.  
  86.     _CmdWindow.dbCalc.b1.Enabled      = .T.
  87.     _Cmdwindow.dbCalc.b2.Enabled      = .T.
  88.     _Cmdwindow.dbCalc.b3.Enabled      = .T.
  89.     _Cmdwindow.dbCalc.b4.Enabled      = .T.
  90.     _Cmdwindow.dbCalc.b5.Enabled      = .T.
  91.     _Cmdwindow.dbCalc.b6.Enabled      = .T.
  92.     _Cmdwindow.dbCalc.b7.Enabled      = .T.
  93.     _Cmdwindow.dbCalc.b8.Enabled      = .T.
  94.     _Cmdwindow.dbCalc.b9.Enabled      = .T.
  95.     _Cmdwindow.dbCalc.b0.Enabled      = .T.
  96.     _Cmdwindow.dbCalc.bplus.Enabled   = .T.
  97.     _Cmdwindow.dbCalc.bequal.Enabled  = .T.
  98.     _Cmdwindow.dbCalc.bminus.Enabled  = .T.
  99.     _Cmdwindow.dbCalc.buminus.Enabled = .T.
  100.     _Cmdwindow.dbCalc.btimes.Enabled  = .T.
  101.     _Cmdwindow.dbCalc.bDec.Enabled    = .T.
  102.     _Cmdwindow.dbCalc.bdivide.Enabled = .T.
  103.  
  104.     _CmdWindow.dbCalc.lastValue =  0
  105.     _CmdWindow.dbCalc.lastKeyOp = .F.
  106.     _CmdWindow.dbCalc.lastOp    = ""
  107.     _CmdWindow.dbCalc.lDec      = .F.
  108.  
  109.     _CmdWindow.dbCalc.e.Text  =  SPACE(15) + "0"
  110. RETURN
  111.  
  112.  
  113. *...........................................
  114. * Procedure Name:   PressOp
  115. * Parameters:       None
  116. * Ext Memvars:      _CmdWindow.dbCalc
  117. * Description:      Processes operator keys
  118. *...........................................
  119. PROCEDURE PressOp
  120. PARAMETER cKey
  121.     PRIVATE lVoid
  122.  
  123.     IF (_CmdWindow.dbCalc.lastKeyOp) .OR. ISBLANK(_CmdWindow.dbCalc.lastOp)
  124.         _CmdWindow.dbCalc.lastValue = VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  125.     ELSE
  126.         DO CASE
  127.             CASE _CmdWindow.dbCalc.lastOp = "+"
  128.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue + VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  129.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  130.             CASE _CmdWindow.dbCalc.lastOp = "-"
  131.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue - VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  132.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  133.             CASE _CmdWindow.dbCalc.lastOp = "*"
  134.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue * VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  135.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  136.             CASE _CmdWindow.dbCalc.lastOp = "/"
  137.                 IF VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text))) # 0
  138.                     _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue / VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  139.                     _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  140.                 ELSE
  141.                     ?? kBell
  142.                     _CmdWindow.dbCalc.e.Text          = "E" + SPACE(15)
  143.                     _CmdWindow.dbCalc.b1.Enabled      = .F.
  144.                     _Cmdwindow.dbCalc.b2.Enabled      = .F.
  145.                     _Cmdwindow.dbCalc.b3.Enabled      = .F.
  146.                     _Cmdwindow.dbCalc.b4.Enabled      = .F.
  147.                     _Cmdwindow.dbCalc.b5.Enabled      = .F.
  148.                     _Cmdwindow.dbCalc.b6.Enabled      = .F.
  149.                     _Cmdwindow.dbCalc.b7.Enabled      = .F.
  150.                     _Cmdwindow.dbCalc.b8.Enabled      = .F.
  151.                     _Cmdwindow.dbCalc.b9.Enabled      = .F.
  152.                     _Cmdwindow.dbCalc.b0.Enabled      = .F.
  153.                     _Cmdwindow.dbCalc.bplus.Enabled   = .F.
  154.                     _Cmdwindow.dbCalc.bequal.Enabled  = .F.
  155.                     _Cmdwindow.dbCalc.bminus.Enabled  = .F.
  156.                     _Cmdwindow.dbCalc.buminus.Enabled = .F.
  157.                     _Cmdwindow.dbCalc.btimes.Enabled  = .F.
  158.                     _Cmdwindow.dbCalc.bDec.Enabled    = .F.
  159.                     _Cmdwindow.dbCalc.bdivide.Enabled = .F.
  160.                 ENDIF
  161.         ENDCASE
  162.     ENDIF
  163.  
  164.     _CmdWindow.dbCalc.lastKeyOp = .T.
  165.  
  166.     IF TYPE("cKey") = "C"
  167.         _CmdWindow.dbCalc.lastOp = m->cKey
  168.     ELSE
  169.         _CmdWindow.dbCalc.lastOp = SUBSTR(ALLTRIM(This.Text), 2, 1)
  170.     ENDIF
  171.  
  172.     IF _CmdWindow.dbCalc.lastOp = "="
  173.         _CmdWindow.dbCalc.lastOp = ""
  174.     ENDIF
  175. RETURN
  176.  
  177.  
  178. *.......................................................
  179. * Procedure Name:   NumClick
  180. * Parameters:       None
  181. * Ext Memvars:      _CmdWindow.dbCalc.e.Text
  182. * Description:      Processes numbers in the calculator
  183. *.......................................................
  184. PROCEDURE NumClick
  185. PARAMETERS cNum
  186.     PRIVATE cNStr, lVoid
  187.  
  188.     IF TYPE("cNum") # "C"
  189.         cNum = SUBSTR(This.Text, 2, 1)
  190.     ENDIF
  191.  
  192.     cNum = ALLTRIM(m->cNum)
  193.  
  194.     IF _CmdWindow.dbCalc.lastKeyOp
  195.         IF m->cNum # kPoint
  196.             _CmdWindow.dbCalc.e.Text = MakeNum(VAL(m->cNum))
  197.             _CmdWindow.dbCalc.lDec      = .F.
  198.         ELSE
  199.             _CmdWindow.dbCalc.e.Text   = MakeNum(0)
  200.             _CmdWindow.dbCalc.lDec      = .T.
  201.         ENDIF
  202.         _CmdWindow.dbCalc.lastKeyOp = .F.
  203.     ELSE
  204.         IF m->cNum # kPoint
  205.             cNStr = ALLTRIM(_CmdWindow.dbCalc.e.Text)
  206.  
  207.             IF (_CmdWindow.dbCalc.lDec) .AND. (.NOT.(kPoint $ m->cNStr)) .AND. (LEN(m->cNStr) < 16)
  208.                 cNStr = m->cNStr + kPoint
  209.             ENDIF
  210.  
  211.             IF LEN(m->cNStr) < 16
  212.                 IF m->cNStr == "0"
  213.                     cNStr = ""
  214.                 ENDIF
  215.                 cNStr = m->cNStr + m->cNum
  216.             ENDIF
  217.  
  218.             _CmdWindow.dbCalc.e.Text = SPACE(16 - LEN(m->cNStr)) + m->cNStr
  219.         ELSE
  220.             _CmdWindow.dbCalc.lDec = .T.
  221.         ENDIF
  222.     ENDIF
  223. RETURN
  224.  
  225.  
  226. *......................................
  227. * Procedure Name:   CalClose
  228. * Parameters:       None
  229. * Ext Memvars:      dbCalc
  230. * Description:      Release Calculator
  231. *......................................
  232. PROCEDURE CalClose
  233.     lVoid = _CmdWindow.dbCalc.Close()
  234.     lVoid = _CmdWindow.dbCalc.Release()
  235.     _CmdWindow.dbCalc = .F.
  236.     RELEASE dbCalc
  237. RETURN
  238.  
  239.  
  240. *............................................................
  241. * Procedure Name:   ClcAbout
  242. * Parameters:       None
  243. * Ext Memvars:      None
  244. * Description:      Displays an about box for the calculator
  245. *............................................................
  246. PROCEDURE ClcAbout
  247.     PRIVATE lVoid
  248.  
  249.     #include "CLCABOUT.DFM"
  250.  
  251.     lVoid = ClcAbout.ReadModal()
  252.     lVoid = ClcAbout.Release()
  253.     RELEASE ClcAbout
  254. RETURN
  255.  
  256. *.........................................................................
  257. * Procedure Name:   bCopy
  258. * Parameters:       None
  259. * Ext Memvars:      _Clipboard
  260. * Description:      Copies the current value of _CmdWindow.dbCalc.e to the Clipboard
  261. *.........................................................................
  262. PROCEDURE bCopy
  263.     PRIVATE cNum
  264.  
  265.     cNum = ALLTRIM(_CmdWindow.dbCalc.e.Text)
  266.  
  267.     _Clipboard.InsertLine = m->cNum
  268.     _Clipboard.ExtendSelection = .T.
  269.     _Clipboard.Column = 1
  270.     _Clipboard.ExtendSelection = .F.
  271. RETURN
  272.  
  273.  
  274. *............................................................................
  275. * Function Name:    MakeNum
  276. * Parameters:       nVal, a numeric
  277. * Ext Memvars:      None
  278. * Return Value:     string
  279. * Description:      converts nVal to a padded string
  280. *............................................................................
  281. FUNCTION MakeNum
  282. PARAMETERS nVal
  283.     PRIVATE cStr
  284.  
  285.     cStr = ALLTRIM(STR(m->nVal, 16, 14))
  286.  
  287.     IF (kPoint $ m->cStr) .AND. (.NOT.("E" $ m->cStr))
  288.         DO WHILE RIGHT(m->cStr,1) = "0"
  289.             cStr = LEFT(m->cStr, LEN(m->cStr) - 1)
  290.         ENDDO
  291.  
  292.         IF (RIGHT(m->cStr,1) = kPoint)
  293.             cStr = LEFT(m->cStr, LEN(m->cStr) - 1)
  294.         ENDIF
  295.     ENDIF
  296.  
  297.     cStr = SPACE(16 - LEN(m->cStr)) + m->cStr
  298. RETURN m->cStr
  299.  
  300.  
  301. *..........................................................................
  302. * Function Name:    CvtPoint
  303. * Parameters:       string of a number
  304. * Ext Memvars:      None
  305. * Return Value:     string, number with "." as decimal point
  306. * Description:      Takes a numeric string and makes sure that the decimal
  307. *                   point is a ".".  Helps the calculator work
  308. *                   internationally.
  309. *..........................................................................
  310. FUNCTION CvtPoint
  311. PARAMETERS cStr
  312.     PRIVATE cRet
  313.  
  314.     cRet = ""
  315.  
  316.     IF (kPoint $ m->cStr) .AND. (kPoint # ".")
  317.         cRet = STUFF(m->cStr, AT(kPoint, m->cStr), 1, ".")
  318.     ELSE
  319.         cRet = m->cStr
  320.     ENDIF
  321.  
  322. RETURN m->cRet
  323.  
  324.  
  325. *......................................................................
  326. * Procedure Name:   IDEHelp
  327. * Parameters:       None
  328. * Ext Memvars:      None
  329. * Description:      Calls the help system with current object's HelpID
  330. *......................................................................
  331. PROCEDURE IDEHelp
  332.     PRIVATE lVoid
  333.  
  334.     _SysHelp.HelpID = This.HelpID
  335.     lVoid = _SysHelp.ReadModal()
  336. RETURN
  337.  
  338.  
  339.